home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Remove Returns / Remove Returns.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  1.8 KB  |  78 lines  |  [TEXT/CWIE]

  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10.  
  11. unit OneReturn;
  12.  
  13. interface
  14.  
  15.     uses
  16.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  17.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  18.  
  19.  
  20.  
  21. {$MAIN}
  22.                         
  23.     procedure main;        
  24.  
  25. implementation
  26.  
  27.  
  28. procedure dopaste;
  29.     const
  30.         pastecode=2422;
  31.     var 
  32.         qel: EvQelPtr;
  33.     begin
  34.             if ppostevent(3, pastecode, qel) = noerr then
  35.             qel^.evtqmodifiers := cmdkey;
  36.     end;
  37.  
  38.     
  39.     procedure main;
  40.         const
  41.             step = 1000;
  42.         var
  43.             oldA4: LongInt;
  44.             myerr: oserr;
  45.             myclipsize, templongint: longint;
  46.             myclipHandle: handle;
  47.             substhandle: Handle;
  48.             i: integer;
  49.             subst: str15;
  50.     begin
  51.         oldA4 := SetCurrentA4;
  52.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  53.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  54.         if myerr=noerr then 
  55.             begin
  56.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  57.                 if myclipsize > 0 then
  58.                     begin
  59.                         subst := '12';
  60.                         subst[1] := char(ord(13));
  61.                         subst[2] := char(ord(13));
  62.                         substhandle := newhandle(1);
  63.                         blockmove(@subst[1], substhandle^, 1);
  64.                         repeat
  65.                             i := ReplaceText(mycliphandle, substhandle, subst);
  66.                         until i = 0;
  67.                         myerr := ZeroScrap;
  68.                         myclipsize:=gethandlesize(myclipHandle);
  69.                         Temphlock(mycliphandle,myerr);
  70.                         myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  71.                         Temphunlock(myCliphandle,myerr);
  72.                         dopaste;
  73.                     end;
  74.             end;
  75.         TempDisposeHandle(myCliphandle,myerr);
  76.         oldA4 := SetA4(oldA4);
  77.     end;
  78. end.